home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / PINBSRC.ZIP / PLANES / GRABBLER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-02  |  2.7 KB  |  125 lines
  1. { Needs BGI256.BGI! }
  2. program SPRITE_GRABBLER;
  3. uses graph,dos,crt,printer;
  4. TYPE  ByteArray = array[0..64000] of byte;
  5. var name:string[80];
  6.     datei:file;
  7.     datei1,datei2,datei3,datei4:file of byte;
  8.     zeiger:word;
  9.     platz1:pointer;
  10.     kill:byte;
  11.     groesse:word;
  12.     platz:^Bytearray;
  13.     treiber, modus:integer;
  14.     Palette: file of byte;
  15.     Color: Word;
  16.     x,y,x1,y1:integer;
  17.     z,z1:word;
  18.     pixel:string;
  19.     pixe:word;
  20.     code:integer;
  21.     lag:file;
  22.     ok:boolean;
  23.     ch:char;
  24.     red,green,blue:byte;
  25.    result:integer;
  26. begin
  27.    write('Dateiname:');
  28.    readln(name);
  29.    kill:=0;
  30.    result := installuserdriver( 'BGI256', nil);
  31.    modus:=0;
  32.    initgraph(result,modus,'');
  33.  
  34.    assign(datei,name+'.VGA');
  35.    reset(datei,1);
  36.  
  37.    groesse:=imagesize(0,0,319,199);
  38.    getmem(platz1,groesse);
  39.  
  40.    blockread(datei,platz1^,groesse);
  41.    close(datei);
  42.    putimage(0,0,platz1^,0);
  43.      x1:=160;
  44.      y1:=136;
  45.      x:=160+56;
  46.      y:=136+47; {}
  47.  
  48. {     x1:=80;
  49.      y1:=136;
  50.      x:=80+56;
  51.      y:=136+47;{}
  52.  
  53.   ok:=false;
  54.   setwritemode(xorput);
  55.   rectangle(x1,y1,x,y);
  56.   repeat
  57.     repeat
  58.     until KeyPressed;
  59.     setwritemode(xorput);
  60.     rectangle(x1,y1,x,y);
  61.     ch:=readkey;
  62.     if ch='8' then y:=y-4;
  63.     if ch='2' then y:=y+4;
  64.     if ch='4' then x:=x-8;
  65.     if ch='6' then x:=x+8;
  66.     if ch='5' then ok:=true;
  67.     if ch='s' then y1:=y1-4;
  68.     if ch='x' then y1:=y1+4;
  69.     if ch='y' then x1:=x1-8;
  70.     if ch='c' then x1:=x1+8;
  71.  
  72.     if x<0 then x:=0;
  73.     if y<0 then y:=0;
  74.     if x>319 then x:=319;
  75.     if y>199 then y:=199;
  76. {    x1:=x-32;
  77.     y1:=y-74;}
  78.  
  79.  
  80.     rectangle(x1,y1,x,y);
  81.   until ok;
  82.     rectangle(x1,y1,x,y);
  83.  
  84. {  assign(lag,'larry11.SPR');
  85.   rewrite(lag,1);}
  86. {  groesse:=imagesize(x1,y1,x,y);
  87.   getmem(platz,groesse);
  88.   getimage(x1,y1,x,y,platz^);
  89.   putimage(x1,y1,platz^,copyput);}
  90.   write(lst,name,' ',(x-x1));
  91.   write(lst,' ',(y-y1+1));
  92.   writeln(lst,' X:',x1,'-',x,' Y:',y1,'-',y);
  93.  
  94.   assign(datei1,name+'_r.1');
  95.   assign(datei2,name+'_r.2');
  96.   assign(datei3,name+'_r.3');
  97.   assign(datei4,name+'_r.4');
  98.   rewrite(datei1);
  99.   rewrite(datei2);
  100.   rewrite(datei3);
  101.   rewrite(datei4);
  102.   for z:=y1 to y do
  103.   begin
  104.     for z1:=x1+1 to x do
  105.     begin
  106.       write(datei1,mem[$a000:z*320+z1]);
  107.       write(datei2,mem[$a000:z*320+z1+1]);
  108.       write(datei3,mem[$a000:z*320+z1+2]);
  109.       write(datei4,mem[$a000:z*320+z1+3]);
  110.       mem[$a000:z*320+z1]:=255;
  111.       mem[$a000:z*320+z1+1]:=255;
  112.       mem[$a000:z*320+z1+2]:=255;
  113.       mem[$a000:z*320+z1+3]:=255;
  114.       inc(z1,3);
  115.     end;
  116.   end;
  117.   close(datei1);
  118.   close(datei2);
  119.   close(datei3);
  120.   close(datei4);
  121.   closegraph;
  122. {  blockwrite(lag,platz^,groesse);}
  123. {close(lag);}
  124. end.
  125.